Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/multi2.zip/QUEUE.PAS

Pascal/Delphi Source File | 1993-01-04 | 11KB | 276 lines

{//////////////////////////////////////////////////////////////////////////////
///                                                                         ///
///           Universelle Verwaltung doppelt verketteter Listen             ///
///                                                                         ///
///                 (c) Christian Philipps, Moers                           ///
///                       im November 1988                                  ///
///                                                                         ///
///              Dieses System erfordert Turbo-Pascal V5.0                  ///
///              und die Unit CpMulti                                       ///
///                                                                         ///
///  Wann immer ein Element entfernt werden soll, das sich am Kopf bzw.     ///
///  Ende der Queue befindet, ist der Aufwand für die Löschung konstant.    ///
///  Die durchschnittliche Löschzeit bei Elementen aus der Mitte der Queue, ///
///  wächst proportional zur Anzahl der Elemente in der Kette.              ///
///                                                                         ///
//////////////////////////////////////////////////////////////////////////////}

{$R-,S-,I-,D-,F-,V-,B-,N-,L-,O-}

UNIT Queue;

INTERFACE

USES CpMulti, CpMisc;

TYPE  QueuePtrType  = ^QueueRecType;
      QueueRecType  = RECORD                     {Queue-Element}
                        Data     : Pointer;      {Zeiger auf Datenbereich}
                        Next     : QueuePtrType; {Zeiger auf nächstes Element}
                        Prev     : QueuePtrType; {Zeiger auf Vorgänger}
                      END;
      QueDataType   = LongInt;
      QueueType     = RECORD                     {Anker der Queue}
                        Critical : Pointer;      {Semaphore für Update-Zugriff}
                        Elements : Pointer;      {Element-Count}
                        QueData  : QueDataType;  {User-Defined Data}
                        First    : QueuePtrType; {Zeiger auf Queue-Anfang}
                        Last     : QueuePtrType; {Zeiger auf Queue-Ende}
                      END;
      VergFuncType  = FUNCTION(Vergleichswert, Data:Pointer):BOOLEAN;

PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);
FUNCTION  RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;
PROCEDURE CreQueue(VAR Q:QueueType);
FUNCTION  DeleteQueue(VAR Q:QueueType):BOOLEAN;
FUNCTION  FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
                  ElemFound:VergFuncType):Pointer;

{-----------------------------------------------------------------------------}

IMPLEMENTATION

TYPE QueueErrType  = (QueCreSem, QueRemSem, QueHeap);

VAR  SearchQueue : Pointer;

{-----------------------------------------------------------------------------}

PROCEDURE QueueErr(ErrNo:QueueErrType);

BEGIN {QueueErr}
  Write(^G'Queue: ');
  CASE ErrNo OF
    QueHeap:   Writeln('Zuwenig dynamischer Speicher vorhanden!');
    QueCreSem: Writeln('Fehler beim Anlegen einer Semaphore!');
    QueRemSem: Writeln('Fehler beim Löschen einer Semaphore!');
  ELSE Writeln('Unbekannter Fehler: ',Byte(ErrNo));
  END;
  Halt(1);
END;  {QueueErr}

{-----------------------------------------------------------------------------}

PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);

{ Anhängen eines Elementes an die durch QueueRec verwaltete Queue.
  Für das Element wird ein Verwaltungssatz angelegt. Fehlt der hierfür er-
  forderliche dynamische Speicher, so wird die Aktion abgebochen!
  Zum Abschluß der Aktion wird der Element-Count der Queue erhöht!
}

VAR   Elem : QueuePtrType;

BEGIN {AppendRec}
  IF MaxAvail < SizeOf(QueueRecType)
     THEN QueueErr(QueHeap);

  SafeGetMem(Elem,SizeOf(Elem^));                {erzeuge Verwaltungssatz}
  Elem^.Next := NIL;                             {Bildet das Kettenende}
  Elem^.Data := Data;                            {hänge Datenbereich ein}

  WITH QueueRec DO
  BEGIN
    SemWait(Critical);                           {Kritischer Bereich}
    IF First = NIL                               {erstes Kettenelement}
       THEN First := Elem
       ELSE BEGIN
              Last^.Next := Elem;                {Verketten}
            END;
    Elem^.Prev := Last;                          {Vorgänger merken}
    Last := Elem;                                {neues Kettenende merken}
    SemSignal(Critical);                         {Freigeben der Queue}
    SemSignal(Elements);                         {Erhöhe Anzahl Elemente}
  END;
END; {AppendRec}

{-----------------------------------------------------------------------------}

FUNCTION RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;

{
  Entfernen des Queue-Elementes auf dessen Datenbereich der Zeiger Data
  verweist. Dieser Zeiger MUSS auf ein gültiges Kettenelement verweisen, da
  zur Verbesserung der Performance von dieser Voraussetzung ausgegangen wird.
  Fehlerhafte Datenbereichszeiger werden mit einiger Sicherheit im Nirwana
  enden; günstigsten Falles jedoch mit einer ungültige Pointeroperation.
  Der Verwaltungssatz zu diesem Element wird freigegeben.
  ACHTUNG!!! Der Element-Count wird NICHT verändert, da in der Regel auf die
  Warteschlange über ein SemWait(Elements) zugegriffen wird, wenn die Entnahme
  von Daten beabsichtigt ist. Durch diesen Aufruf wurde der Element-Count be-
  reits vor Aufruf von RemoveRec erniedrigt.
}

LABEL ExitRemove;

VAR   Elem  : QueuePtrType;

BEGIN {RemoveRec}
  RemoveRec := Data;                          { Zeiger auf Elem zurückliefern }

  WITH QueueRec DO
  BEGIN
    SemWait(Critical);                        { Exclusiver Zugriff erforderlich}
    Elem := First;                            { für 2 Fälle zutreffend }
    IF First = Last                           { nur 1 Kettenelement }
       THEN BEGIN
              First := NIL;
              Last  := NIL;
              Goto ExitRemove;
            END;

    IF First^.Data = Data                     { erstes Element! }
       THEN BEGIN
              First := First^.Next;
              First^.Prev := NIL;
              Goto ExitRemove;
            END;

    IF Last^.Data = Data                      { letztes Element }
       THEN BEGIN
              Elem := Last;                   { für FreeMem }
              Last^.Prev^.Next := NIL;        { Vorwärtskette abschließen }
              Last := Last^.Prev;             { Last aktualisieren }
              Goto ExitRemove;
            END;

    Elem  := First;                           { suche den Verwaltungssatz }
    WHILE Elem^.Data <> Data DO
      Elem := Elem^.Next;

    Elem^.Prev^.Next := Elem^.Next;           { Vorwärtsverweis durchreichen }
    Elem^.Next^.Prev := Elem^.Prev;           { und rückverketten }

ExitRemove:
    SafeFreeMem(Elem,SizeOf(Elem^));          { Freigeben Verwaltungssatz}
    SemSignal(Critical);                      { Freigeben der Queue }
  END;
END;  {RemoveRec}

{-----------------------------------------------------------------------------}

PROCEDURE CreQueue(VAR Q:QueueType);

{ Anlegen und Initialisieren einer Queue }

BEGIN {CreQueue}
  WITH Q DO
  BEGIN
    IF (CreateSem(Critical) <> Sem_Ok) OR
       (CreateSem(Elements) <> Sem_Ok)
       THEN QueueErr(QueCreSem);

    SemClear(Elements);
    First     := NIL;
    Last      := NIL;
  END;
END;  {CreQueue}

{-----------------------------------------------------------------------------}

FUNCTION DeleteQueue(VAR Q:QueueType):BOOLEAN;
{
  Löschen einer Queue, sofern diese derzeit keine Elemente enthält.
  Aller durch die Semaphoren belegte Speicherplatz wird wieder freigegeben.
  Ist die Warteschlange einer Semaphore nicht leer, oder enthält die Queue
  noch Elemente, so zeigt der Funktionswert FALSE Mißerfolg an.
}
BEGIN {DeleteQueue}
  DeleteQueue := False;
  WITH Q DO
  BEGIN
    IF (First <> NIL)         OR
       SemSoWaiting(Critical) OR
       SemSoWaiting(Elements)
       THEN Exit;

    IF (RemoveSem(Critical) <> Sem_OK) OR
       (RemoveSem(Elements) <> Sem_OK)
       THEN QueueErr(QueRemSem);
  END;
  DeleteQueue := True;
END;  {DeleteQueue}

{-----------------------------------------------------------------------------}

FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
                 ElemFound:VergFuncType):Pointer;

{
  Durchsuchen einer Queue nach einem bestimmten Element.
  Der Parameter Data ist ein Zeiger auf ein irgendwie geartetes Datenelement,
  das die durch Func angesprochene Funktion als Vergleichswert benötigt.
  Func ist ein Zeiger auf eine Funktion, die als Parameter zwei Zeiger, einen
  auf den Vergleichswert und einen auf den Datenbereich eines Queue-Elements
  erhält. Der Funktionswert dieser Funktion zeigt an, ob das gesuchte Element
  gefunden werden konnte. True = Gefunden. Diese Funktion muß eine FAR-Funk-
  tion sein, also z. B. mit dem Compilerswitch F+ compiliert worden sein.
  Kann in der gesamten Queue kein passendes Element gefunden werden, so lie-
  fert FindRec NIL, anderenfalls einen Zeiger auf den Datenbereich des ge-
  fundenen Kettenelementes.
  Während der Suche wird die Queue blockiert, um gleichzeitige Updates auszu-
  schließen. Ferner wird durch die Semaphore SearchQueue gewährleistet, daß
  zu einem Zeitpunkt immer nur eine Suchanforderung aktiv sein kann. Dies ist
  erforderlich, da jede Suchanforderung die globale Variable ProcAddr verän-
  dert, die auf die Vergleichsfunktion verweist.
}

LABEL ExitFindRec;

VAR   Elem : QueuePtrType;

BEGIN {FindRec}
  SemWait(SearchQueue);                          {ProcAddr exclusiv anfordern}
  FindRec  := NIL;
  WITH QueueRec DO
  BEGIN
    SemWait(Critical);                           {blockiere die Queue}
    IF First = NIL
       THEN Goto ExitFindRec                     {Queue leer}
       ELSE Elem := First;                       {initialisiere Arbeitspointer}

    WHILE (Elem <> NIL) DO
      IF ElemFound(Vergleichswert,Elem^.Data)
         THEN BEGIN                              {Eintrag gefunden}
                FindRec := Elem^.Data;
                Goto ExitFindRec;
              END
         ELSE Elem := Elem^.Next;                {weiter mit Folgeelement}

ExitFindRec:
    SemSignal(Critical);
    SemSignal(SearchQueue);
  END;
END;  {FindRec}

{-----------------------------------------------------------------------------}

BEGIN {Initialisierung}
IF CreateSem(SearchQueue) <> Sem_OK
   THEN QueueErr(QueCreSem);
END.  {Initialisierung}

{//////////////////////////////////////////////////////////////////////////////
///                    Ende des Moduls                                      ///
//////////////////////////////////////////////////////////////////////////////}